home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / a_utils / ffccflow / ffccflow.lha / ffccc+flow / flow / procht.for < prev    next >
Text File  |  1992-07-31  |  8KB  |  264 lines
  1.       SUBROUTINE PROCHT
  2. C! Produce the graphics SC
  3.       INCLUDE 'params.h'
  4.       INCLUDE 'jobcom.h'
  5.       INCLUDE 'lunits.h'
  6.       INCLUDE 'trecom.h'
  7.       INCLUDE 'tables.h'
  8.       INCLUDE 'hashnm.h'
  9.       INTEGER SEARCH
  10.       EXTERNAL SEARCH
  11.       LOGICAL OK
  12. C
  13. C
  14.       WRITE(LOUT,'(A)') ' '
  15.       WRITE(LOUT,'(A)') ' PROCHT Begins ....'
  16.       WRITE(LOUT,'(A)') ' '
  17. C
  18. C check for first procedure unknown
  19. C
  20.       IF(CTREE.EQ.'$$$$') THEN
  21.         MXCALL = 0
  22. C
  23. C find all top-level procedures. Select one with max calls
  24. C
  25.         DO 700 IP=1,NPROC
  26.           IF(PROCED_NCALLEDBY(IP).GT.0) GOTO 700
  27.           WRITE(LOUT,'(A)') ' Procedure '//PROCED_NAME(IP)//
  28.      &                      ' is a top-level node (no callers)'
  29.           IF(PROCED_NCALLS(IP).LE.MXCALL) GOTO 700   
  30.           MXCALL = PROCED_NCALLS(IP)
  31.           CTREE = PROCED_NAME(IP)
  32.   700   CONTINUE
  33.         WRITE(LOUT,'(/,A,I3,A)') ' Procedure '//CTREE//
  34.      &      'selected with the ',MXCALL,' procedures it calls ...'
  35.       ENDIF
  36. C
  37.       IF(.NOT.LEXT) WRITE(LOUT,551)
  38.   551 FORMAT(' EXTERNAL procedure names will not appear ',/)
  39. C
  40.       CNAM = CTREE
  41. C
  42. C find top node program
  43. C
  44.       IPNAM = SEARCH(CNAM)
  45.       IF(IPNAM.EQ.0) GOTO 900
  46.       IF(PROCED_NCALLS(IPNAM).EQ.0) GOTO 950
  47. C
  48. C initialise all places in the chart
  49. C
  50.       DO 1 I=0,NXPOS
  51.         DO 2 J=1,NYPOS
  52.           CPLACE(I,J)(:MXNAM) = ' '
  53.           CPLACE(-I,J) = CPLACE(I,J)
  54.     2   CONTINUE
  55.     1 CONTINUE
  56. C
  57.       MXLEV = 1
  58.       NLEFT = 1
  59.       INEXT(1) = IPNAM
  60.       NUMBER(ILEV) = 0
  61.       PROCED_LEVEL(IPNAM) = 1
  62. C
  63. C Assign levels to all procedures
  64. C
  65.    10 CONTINUE
  66.       IF(NLEFT.LE.0) GOTO 20
  67. C
  68. C Take the last in the list
  69. C
  70.       IPNAM = INEXT(NLEFT)
  71.       NLEFT = NLEFT - 1
  72.       ILEV = PROCED_LEVEL(IPNAM)     
  73.       DO 11 IC=1,PROCED_NCALLS(IPNAM)
  74.          IPNAM2 = PROCED_CALLS(IPNAM,IC)
  75.          IF(.NOT.LEXT.AND.PROCED_EXTERN(IPNAM2)) GOTO 11
  76.          IF(PROCED_LEVEL(IPNAM2).LE.ILEV) THEN
  77.             PROCED_LEVEL(IPNAM2) = ILEV + 1
  78.             IEXT = 0
  79.             IF(PROCED_EXTERN(IPNAM2)) IEXT=1
  80.             IF(PROCED_LEVEL(IPNAM2).GT.MXLEV) THEN
  81.                IF((IEXT.EQ.1.AND.LEXT).OR.IEXT.EQ.0) THEN
  82.                  MXLEV = PROCED_LEVEL(IPNAM2)
  83.                ENDIF
  84.             ENDIF
  85. C
  86. C before adding to list, check not already there ....
  87. C
  88.             DO 12 IL=1,NLEFT
  89.                IF(INEXT(IL).EQ.IPNAM2) GOTO 11
  90.    12       CONTINUE
  91.             IF(NLEFT.GE.MXLFT) GOTO 960
  92.             NLEFT = NLEFT + 1
  93.             INEXT(NLEFT) = IPNAM2
  94.          ENDIF
  95.    11 CONTINUE
  96.       GOTO 10            
  97. C
  98. C Start to allocate positions in the chart
  99. C The chart has NUMMAX x positions, and MXLEV y positions
  100. C
  101.    20 CONTINUE
  102.       NUMMAX = 0
  103.       DO 4 I=1,NYPOS
  104.         NUMBER(I) = 0
  105.     4 CONTINUE
  106.       DO 23 I=1,NPROC
  107.         IF(PROCED_LEVEL(I).LE.1) GOTO 23
  108.         IF(.NOT.LEXT.AND.PROCED_EXTERN(I)) GOTO 23
  109.         N = NUMBER(PROCED_LEVEL(I))+1
  110.         NUMBER(PROCED_LEVEL(I)) = N
  111.         IF (N.GT.NUMMAX) NUMMAX = N
  112.    23 CONTINUE
  113.       ITREE = SEARCH(CTREE)
  114.       DO 28 I=1,NPROC
  115.         PROCED_DONE(I) = .FALSE.
  116.    28 CONTINUE
  117.       NSTEP = NINT(REAL(NUMMAX+1)*0.5)
  118.       IF(NSTEP.GT.NXPOS) GOTO 930
  119.       DO 25 I=1,NPROC
  120.         IF(PROCED_LEVEL(I).LE.1.AND.I.NE.ITREE) GOTO 25
  121.         IF(PROCED_DONE(I)) GOTO 25
  122.         IF(.NOT.LEXT.AND.PROCED_EXTERN(I)) GOTO 25
  123.         ILEV = PROCED_LEVEL(I)
  124.         DO 26 IXP = 0,NSTEP
  125.           IF(CPLACE(-IXP,ILEV)(:1).EQ.' ') THEN
  126.             CPLACE(-IXP,ILEV) = PROCED_NAME(I)
  127.             IXPOS(I) = -IXP
  128.             PROCED_DONE(I) = .TRUE.
  129.             GOTO 27
  130.           ENDIF
  131.           IF(CPLACE(IXP,ILEV)(:1).EQ.' ') THEN
  132.             CPLACE(IXP,ILEV) = PROCED_NAME(I)
  133.             IXPOS(I) = IXP
  134.             PROCED_DONE(I) = .TRUE.
  135.             GOTO 27
  136.           ENDIF
  137.    26   CONTINUE
  138.    27   CONTINUE
  139.         IF(.NOT.PROCED_DONE(I)) GOTO 940
  140.         IF(PROCED_NCALLS(I).EQ.0) GOTO 25
  141.         IXPOSI = IXPOS(I)
  142.         DO 35 ICALLED = 1,PROCED_NCALLS(I)
  143.           IOTHER = PROCED_CALLS(I,ICALLED)
  144.           IF(PROCED_DONE(IOTHER)) GOTO 35
  145.           IF(.NOT.LEXT.AND.PROCED_EXTERN(IOTHER)) GOTO 35
  146.           ILEVO = PROCED_LEVEL(IOTHER)
  147.           ISTART = MAX(-NSTEP,IXPOSI - ILEVO + ILEV + 1)
  148.           DO 36 IPOS=ISTART,-NSTEP,-1
  149.             IF(CPLACE(IPOS,ILEVO)(:1).EQ.' ') THEN
  150.               PROCED_DONE(IOTHER) = .TRUE.
  151.               CPLACE(IPOS,ILEVO) = PROCED_NAME(IOTHER)
  152.               IXPOS(IOTHER) = IPOS
  153.               GOTO 35
  154.             ENDIF
  155.    36     CONTINUE
  156.           DO 37 IPOS=ISTART,NSTEP
  157.             IF(CPLACE(IPOS,ILEVO)(:1).EQ.' ') THEN
  158.               PROCED_DONE(IOTHER) = .TRUE.
  159.               CPLACE(IPOS,ILEVO) = PROCED_NAME(IOTHER)
  160.               IXPOS(IOTHER) = IPOS
  161.               GOTO 35
  162.             ENDIF
  163.    37     CONTINUE
  164.    35   CONTINUE
  165.    25 CONTINUE
  166. C
  167. C This is the end of the simple cut at chart positioning
  168. C
  169. C
  170. C Write a text representation of the chart as an indication only
  171. C
  172.       WRITE(LOUT,'(A)') ' The chart will look roughly like this ...'
  173.       WRITE(LOUT,501)
  174.       DO 41 IL=1,MXLEV
  175.          WRITE(LOUT,*) (CPLACE(IS,IL),IS=-NSTEP,NSTEP)
  176.    41 CONTINUE
  177.       WRITE(LOUT,501)
  178.   501 FORMAT(1X,79('-'))
  179. C
  180. C begin calculating the sizes of objects for the plot
  181. C
  182.       WRITE(LOUT,'(A)') ' PROCHT : START CREATING PLOT'
  183.       BOXX = 18.
  184.       BOXY = 7.
  185.       GAPX = 5.
  186.       GAPY = 12.
  187.       SIZEX = (NUMMAX+2)*BOXX + (NUMMAX+3)*GAPX
  188.       SIZEY = MXLEV*BOXY + (MXLEV+1)*GAPY
  189.       SIZEX = MAX(SIZEX,SIZEY)
  190.       SIZEY = SIZEX
  191.       GAPY = MAX(GAPY,(SIZEY-MXLEV*BOXY)/(MXLEV+1))
  192.       GAP = MIN(GAPX,GAPY)
  193. C
  194. C Initialise GRAPHICS
  195. C
  196.       CALL GRINIT(SIZEX,SIZEY,CTREE)
  197. C
  198. C Draw inner box around area
  199. C
  200.       CALL CHTBOX(GAP*0.5,GAP*0.5,SIZEX-GAP*0.5,SIZEY-GAP*0.5)
  201. C
  202. C Start looping over all modules to plot their positions
  203. C
  204.       DO 29 J=1,MXLEV
  205.         DO 31 I=-NSTEP,NSTEP
  206.           IF(CPLACE(I,J)(:1).EQ.' ') GOTO 31
  207.           IP = NSTEP+I
  208.           XLOW = GAPX + IP*(BOXX+GAPX)
  209.           YLOW = SIZEY - J*(GAPY+BOXY)
  210.           INUM = SEARCH(CPLACE(I,J))
  211.           IF(INUM.EQ.0) GOTO 31
  212.           XBOX(INUM) = XLOW+BOXX*0.5
  213.           YBOX(INUM) = YLOW+BOXY*0.5
  214.           CALL CHTBOX(XLOW,YLOW,XLOW+BOXX,YLOW+BOXY)
  215.           CALL GTX(XLOW+BOXX/25.,YLOW+BOXY*0.5,CPLACE(I,J))
  216.    31   CONTINUE
  217.    29 CONTINUE
  218. C
  219. C Now loop over all modules to plot their connections
  220. C
  221.       DO 32 J=1,MXLEV-1
  222.          DO 33 I=-NSTEP,NSTEP
  223.             IF(CPLACE(I,J)(:1).EQ.' ') GOTO 33
  224.             IPNAM = SEARCH(CPLACE(I,J))
  225.             IF(PROCED_NCALLS(IPNAM).EQ.0) GOTO 33
  226.             X1 = XBOX(IPNAM)
  227.             Y1 = YBOX(IPNAM)
  228.             DO 34 IC=1,PROCED_NCALLS(IPNAM)
  229.                IPNAM2 = PROCED_CALLS(IPNAM,IC)
  230.                IF(.NOT.LEXT.AND.PROCED_EXTERN(IPNAM2)) GOTO 34
  231.                CALL CHTLIN(X1,Y1,XBOX(IPNAM2),YBOX(IPNAM2),
  232.      &                     BOXX,BOXY)
  233.    34       CONTINUE
  234.    33    CONTINUE
  235.    32 CONTINUE
  236. C
  237. C Close the graphics package
  238. C
  239.       CALL GRCLOSE
  240. C
  241. C
  242. C finished all trees. home to beddy-bies
  243. C
  244.       WRITE(LOUT,'(A)') ' PROCHT Finished'
  245.       GOTO 999
  246. C
  247.   900 WRITE(LOUT,901) CNAM
  248.   901 FORMAT(1X,'PROCHT : TOPNODE ',A,' NOT FOUND IN PROCEDURE TABLE')
  249.       GOTO 999
  250.   930 WRITE(LOUT,931) 
  251.   931 FORMAT(1X,'PROCHT : NOT ENOUGH SPACE ON THE GRAPH')
  252.       GOTO 999
  253.   940 WRITE(LOUT,941) PROCED_NAME(I)
  254.   941 FORMAT(1X,'PROCHT : NO SPACE FOR ROUTINE ',A)
  255.       GOTO 999
  256.   950 WRITE(LOUT,951) CNAM
  257.   951 FORMAT(1X,'PROCHT : ROUTINE ',A,' CALLS NO OTHER ROUTINES!')
  258.       GOTO 999
  259.   960 WRITE(LOUT,961) MXLFT
  260.   961 FORMAT(1X,'PROCHT : ',I5,' STACK OVERFLOW; TREE TOO COMPLICATED!')
  261. C      
  262.   999 CONTINUE
  263.       END
  264.